home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / IMGASP.ZIP / IMGASPCT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-03-28  |  5.0 KB  |  175 lines
  1. { ****************************************************************** }
  2. {                                                                    }
  3. {   Delphi component TImageAspect                                    }
  4. {                                                                    }
  5. {   Copyright ⌐ 1995 by Indigo Software                              }
  6. {                                                                    }
  7. { ****************************************************************** }
  8.  
  9. {*******************************************************************
  10. Freeware component to display an image in the correct aspect
  11. regardless of the size.
  12. ********************************************************************}
  13. unit ImgAspct;
  14.  
  15. interface
  16.  
  17. {$IFDEF WIN32}
  18. uses Messages, Windows, SysUtils, Classes, Controls, 
  19.      Forms, Menus, Graphics;
  20. {$ELSE}
  21. uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls, 
  22.      Forms, Menus, Graphics;
  23. {$ENDIF}
  24.  
  25.  
  26. type
  27.   TImageAspect = class(TGraphicControl)
  28.     private
  29.         FPicture : TPicture;
  30.         FAutoSize : Boolean;
  31.         procedure AutoInitialize;
  32.         procedure AutoDestroy;
  33.         procedure SetPicture(Value : TPicture);
  34.         procedure SetAutoSize(Value : Boolean);
  35.         procedure WMSize(var Message: TWMSize); message WM_SIZE;
  36.  
  37.     protected
  38.         procedure Paint; override;
  39.         procedure PictureChanged(Sender: TObject);
  40.  
  41.     public
  42.         constructor Create(AOwner: TComponent); override;
  43.         destructor Destroy; override;
  44.  
  45.     published
  46.         property OnClick;
  47.         property OnDblClick;
  48.         property OnDragDrop;
  49.         property OnDragOver;
  50.         property OnEndDrag;
  51.         property OnMouseDown;
  52.         property OnMouseMove;
  53.         property OnMouseUp;
  54.         property Picture : TPicture read FPicture write SetPicture;
  55.         property AutoSize : Boolean read FAutoSize write SetAutoSize;
  56.         property Align;
  57.  
  58.   end;
  59.  
  60. procedure Register;
  61.  
  62. implementation
  63.  
  64. {----------------------------------------------------------}
  65. procedure Register;
  66. begin
  67.    RegisterComponents('Indigo Widgets', [TImageAspect]);
  68. end;
  69.  
  70. {----------------------------------------------------------}
  71. { Method to set variable and property values and create objects }
  72. procedure TImageAspect.AutoInitialize;
  73. begin
  74.    FPicture := TPicture.Create;
  75.    FPicture.OnChange:=PictureChanged;
  76.    FAutoSize := True;
  77. end; { of AutoInitialize }
  78.  
  79. {----------------------------------------------------------}
  80. { Method to free any objects created by AutoInitialize }
  81. procedure TImageAspect.AutoDestroy;
  82. begin
  83.    FPicture.Free;
  84. end; { of AutoDestroy }
  85.  
  86. {----------------------------------------------------------}
  87. procedure TImageAspect.PictureChanged(Sender: TObject);
  88. begin
  89.    {fires when a picture is assigned}
  90.    invalidate;
  91. end;
  92.  
  93. {----------------------------------------------------------}
  94. { Write method for property Picture }
  95. procedure TImageAspect.SetPicture(Value : TPicture);
  96. begin
  97.    FPicture.Assign(Value);
  98.    if autosize and not (picture.graphic = nil) then
  99.       setbounds(left,top,picture.width,picture.height);
  100. end;
  101.  
  102. {----------------------------------------------------------}
  103. { Write method for property autosize }
  104. procedure TImageAspect.SetAutoSize(Value : Boolean);
  105. begin
  106.    FAutoSize:=Value;
  107.    if value and not (picture.graphic = nil) then
  108.       setbounds(left,top,picture.width,picture.height);
  109.    Paint;
  110. end;
  111.  
  112. {----------------------------------------------------------}
  113. constructor TImageAspect.Create(AOwner: TComponent);
  114. begin
  115.    inherited Create(AOwner);
  116.    AutoInitialize;
  117.    width:=32;
  118.    height:=32;
  119. end;
  120.  
  121. {----------------------------------------------------------}
  122. destructor TImageAspect.Destroy;
  123. begin
  124.    AutoDestroy;
  125.    inherited Destroy;
  126. end;
  127.  
  128. {----------------------------------------------------------}
  129. procedure TImageAspect.WMSize(var Message: TWMSize);
  130. begin
  131.    inherited;
  132.    {if you've resized then turn autosize off}
  133.    if autosize and not (picture.graphic = nil) then
  134.       if (width<>picture.width) or (height<>picture.height) then
  135.          autosize:=false;
  136.    paint;
  137. end;
  138.  
  139. {----------------------------------------------------------}
  140. procedure TImageAspect.Paint;
  141. var
  142. x,y:integer;
  143. x1,y1,r:real;
  144. rc:trect;
  145. begin
  146.    if not (picture.graphic = nil) then
  147.    begin
  148.       x1:=width/picture.width;
  149.       y1:=height/picture.height;
  150.       if x1 > y1 then
  151.       begin
  152.          {height is the best fit}
  153.          r:= y1;
  154.          rc.top:=0;
  155.          rc.bottom:=height;
  156.          x:=trunc(picture.width*y1);
  157.          rc.left:=(width-x)div 2;
  158.          rc.right:=rc.left+x;
  159.       end else
  160.       begin
  161.          {width is the best fit}
  162.          r:=x1;
  163.          rc.left:=0;
  164.          rc.right:=width;
  165.          y:=trunc(picture.height*x1);
  166.          rc.top:=(height-y)div 2;
  167.          rc.bottom:=rc.top+y;
  168.       end;
  169.       canvas.stretchdraw(rc,picture.graphic);
  170.    end;
  171.    if csdesigning in componentstate then
  172.       canvas.drawfocusrect(rect(0,0,width,height));
  173. end;
  174. end.
  175.